Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/mdidem/publish.frm

Text File | 1995-05-02 | 7KB | 303 lines

VERSION 2.00
Begin Form Publish
   BackColor       =   &H00C0C0C0&
   Caption         =   "Publishers"
   ClientHeight    =   1245
   ClientLeft      =   3690
   ClientTop       =   2460
   ClientWidth     =   3990
   Height          =   1935
   Icon            =   PUBLISH.FRX:0000
   Left            =   3630
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   1245
   ScaleWidth      =   3990
   Top             =   1830
   Width           =   4110
   Begin TextBox PubName
      DataField       =   "Name"
      DataSource      =   "Data1"
      Height          =   285
      Left            =   135
      MaxLength       =   40
      TabIndex        =   0
      Top             =   315
      Width           =   3615
   End
   Begin Data Data1
      Caption         =   "Data1"
      Connect         =   ""
      DatabaseName    =   ""
      Exclusive       =   0   'False
      Height          =   285
      Left            =   2610
      Options         =   0
      ReadOnly        =   0   'False
      RecordSource    =   "Publishers"
      Top             =   720
      Width           =   1140
   End
   Begin Label FormCommand
      Caption         =   "FormCommand"
      Height          =   240
      Left            =   1440
      TabIndex        =   2
      Top             =   765
      Visible         =   0   'False
      Width           =   1185
   End
   Begin Label Label1
      BackStyle       =   0  'Transparent
      Caption         =   "Name"
      Height          =   240
      Index           =   0
      Left            =   135
      TabIndex        =   1
      Top             =   135
      Width           =   1005
   End
   Begin Menu FileMenu
      Caption         =   "&File"
      Begin Menu OpenMenu
         Caption         =   "&Open"
      End
      Begin Menu SaveMenu
         Caption         =   "&Save"
      End
      Begin Menu NewMenu
         Caption         =   "&New"
      End
      Begin Menu CloseMenu
         Caption         =   "&Close"
      End
      Begin Menu sep
         Caption         =   "-"
      End
      Begin Menu ExitMenu
         Caption         =   "E&xit"
      End
   End
   Begin Menu EditMenu
      Caption         =   "&Edit"
      Begin Menu RestoreMenu
         Caption         =   "&Restore"
      End
      Begin Menu DeleteMenu
         Caption         =   "&Delete"
      End
   End
   Begin Menu WindowMenu
      Caption         =   "&Window"
      WindowList      =   -1  'True
      Begin Menu WindowTileMenu
         Caption         =   "&Tile"
      End
      Begin Menu WindowCascadeMenu
         Caption         =   "&Cascade"
      End
      Begin Menu WindowArrangeIconsMenu
         Caption         =   "&Arrange Icons"
      End
   End
End
Option Explicit
Option Compare Text

Const RecordType = "Publisher"

Sub DeleteMenu_Click ()

On Error GoTo DeleteError

If MsgBox("Are you sure that you want to delete this " & LCase$(RecordType) & "?", MB_YesNo + MB_DefButton2) = IDYes Then
    Data1.Recordset.Delete
    Data1.Refresh
End If

Exit Sub

DeleteError:
    DataError Err, Error$
    Exit Sub

End Sub

Sub ExitMenu_Click ()

Unload MainMdi

End Sub

Sub Form_Load ()

Height = 1935
Width = 4110

Data1.DatabaseName = gDatabaseName
Data1.Refresh

End Sub

Sub FormCommand_Change ()
Dim Cmd As String, Parameter As String
Dim i As Integer

If FormCommand = "" Then Exit Sub

Cmd = Trim$(FormCommand) & " "
i = InStr(Cmd, " ")
Parameter = Trim$(Mid$(Cmd, i + 1))
Cmd = Left$(Cmd, i - 1)

Select Case Cmd
    Case "FindFirst"
        Data1.Recordset.FindFirst Parameter
End Select

FormCommand = ""

End Sub

Sub NewMenu_Click ()

Data1.Recordset.AddNew

End Sub

Sub OpenMenu_Click ()

OpenDialog.Show 1

End Sub

Sub RestoreMenu_Click ()

Data1.UpdateControls

End Sub

Sub SaveMenu_Click ()

On Error GoTo SaveMenuError

If CheckData() Then
    Data1.UpdateRecord
    Data1.Recordset.Bookmark = Data1.Recordset.LastModified
End If

Exit Sub

SaveMenuError:
    Select Case Err
        Case Else
            DataError Err, Error$
    End Select
    Exit Sub

End Sub

Sub WindowArrangeIconsMenu_Click ()

MainMdi.Arrange Arrange_Icons

End Sub

Sub WindowCascadeMenu_Click ()

MainMdi.Arrange Cascade

End Sub

Sub WindowTileMenu_Click ()

MainMdi.Arrange Tile_Horizontal

End Sub

Function CheckData () As Integer

If PubName = "" Then
    MsgBox "Unable to save record. Publisher name is blank."
    CheckData = False
Else
    CheckData = True
End If

End Function

Sub CloseMenu_Click ()

Unload Me

End Sub

Sub Data1_Reposition ()

If Data1.EditMode = Data_EditAdd Then
    Caption = "Adding New Publisher"
ElseIf Data1.Recordset.BOF Or Data1.Recordset.EOF Then
    Caption = "No Publisher Records Found"
Else
    Caption = "Publisher #" & Data1.Recordset("PubID")
End If

End Sub

Sub Data1_Validate (Action As Integer, Save As Integer)

Select Case Action
    Case Data_ActionDelete
        ' this is due to a delete command
        ' calling routine should confirm deletion
     Case Data_ActionUpdate
        ' make sure data is valid
        If CheckData() Then
            Save = True
        Else
            Action = Data_ActionCancel
            Save = False
        End If
     Case Else
        If Save Then
            ' this is due to an implicit save command
            ' make sure they actually want to save it
            If MainMdi.WindowState = Minimized Then MainMdi.WindowState = Normal
            If Me.WindowState = Minimized Then Me.WindowState = Normal
            Me.Show
            Select Case MsgBox("Do you want to save the changes to this " & RecordType & "?", MB_YesNoCancel)
                Case IDYes
                    ' they want to save it
                    ' make sure data is valid
                    If Not CheckData() Then
                        Action = Data_ActionCancel
                        Save = False
                    End If
                Case IDNo
                    Save = False
                Case Else
                    Save = False
                    Action = Data_ActionCancel
            End Select
        End If
End Select

If Save Then
    On Error GoTo ValidateError
    ' perform the save manually
    Save = False
    Data1.UpdateRecord
    Data1.Recordset.Bookmark = Data1.Recordset.LastModified
    SendAll "Refresh Publisher"
End If

Exit Sub

ValidateError:
    DataError Err, Error$
    Action = Data_ActionCancel
    Exit Sub

End Sub